home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
011-020
/
amok19
/
muchmore_1.5
/
muchmore.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
35KB
|
1,071 lines
(*---------------------------------------------------------------------------
:Program. MuchMore.mod
:Author. Fridtjof Siebert
:Address. Nobileweg 67, D-7-Stgt-40
:Phone. (0)711/822509
:Shortcut. [fbs]
:Version. 1.5
:Date. 26-May-89
:Copyright. PD
:Language. Modula-II
:Translator. M2Amiga v3.1d
:Imports QText [fbs]
:History. 26-Nov-88: Now Shows Filelength & Percentage [fbs]
:History. 27-Nov-88: Mouse can be used instead of Space / BackSpace [fbs]
:History. 29-Apr-89: Strong increase in speed, removed WarpText [fbs]
:History. 29-Apr-89: Now supports Numeric Keys (Home,PgUp etc.) [fbs]
:History. 29-Apr-89: Now opens Screen as big as gfx^.normalDisplay [fbs]
:History. 29/30-Apr-89: Asynchronus loading / displaying. Very nice [fbs]
:History. 30-Apr-89, 00:33: Removed bugs in Filelength & L-Command [fbs]
:History. 30-Apr-89, 02:21: Added Find-Command [fbs]
:History. 30-Apr-89, 10:30: Scrolling stops when window is inactive [fbs]
:History. 01-May-89: Allocates no more unneeded memory for text [fbs]
:History. 07-May-89: Allocates even less memory now [fbs]
:History. 14-May-89: Removed deadlock-bug with Find-Window [fbs]
:History. 25-May-89: Added print feature [fbs]
:History. 25-May-89: Removed all imports (apart from Arts) [fbs]
:History. 26-May-89: inspired by J. Kupfer, I added nk 5 to quit [fbs]
:History. 26-May-89: Now handle BS correctly [fbs]
:Contents. A Soft-Scrolling ASCII-File Printer.
:Remark. Usage: MuchMore <FileName>
---------------------------------------------------------------------------*)
MODULE MuchMore; (* $F- $V- $R- $S- I hope that there are no more bugs ! *)
FROM SYSTEM IMPORT ADR, ADDRESS, LONGSET, INLINE, SETREG;
FROM Arts IMPORT TermProcedure, Assert, dosCmdBuf, startupMsg, wbStarted,
Terminate;
FROM Dos IMPORT Open, Close, oldFile, Read, FileHandlePtr, FileLockPtr,
FileInfoBlockPtr, Lock, UnLock, Examine, sharedLock,
Execute, newFile, Delay, ParentDir, DupLock, CurrentDir;
FROM Exec IMPORT GetMsg, ReplyMsg, MessagePtr, WaitPort, AllocMem,
FreeMem, MemReqSet, MemReqs, Task, AddTask, RemTask,
task, Forbid, Permit, TaskPtr, FindTask, Wait, Signal,
AllocSignal, FreeSignal, AvailMem;
FROM Graphics IMPORT ViewModes, ViewModeSet, FontStyleSet, FontFlagSet, TextAttr,
BltClear, OpenFont, CloseFont, TextFontPtr, UCopListPtr,
CBump, CMove, CWait, GfxBase, FreeCopList, BitMapPtr;
FROM InputEvent IMPORT Qualifiers, QualifierSet;
FROM Intuition IMPORT NewScreen, ScreenFlags, ScreenFlagSet, customScreen,
OpenScreen, CloseScreen, MakeScreen, RethinkDisplay,
ScreenPtr, NewWindow, WindowFlags, WindowFlagSet,
IDCMPFlags, IDCMPFlagSet, OpenWindow, CloseWindow,
WindowPtr, IntuiMessage, IntuiMessagePtr, GadgetPtr,
StringInfo, GadgetFlags, GadgetFlagSet, ActivationFlags,
ActivationFlagSet, strGadget, ActivateGadget, ActivateWindow;
FROM Hardware IMPORT custom;
FROM Workbench IMPORT WBStartupPtr;
IMPORT Graphics;
(*-------------------------------------------------------------------------*)
CONST
title = " MuchMore 1.5";
underln = " ==================";
address = "© 1989 Fridtjof Siebert, Nobileweg 67, D-7000-Stuttgart-40";
empty = "";
oom = "Out of Memory!";
cof = "Can't open File!";
nil = "NIL:";
w = TRUE;
f = FALSE;
MaxLen = 256;
TYPE
TextLinePtr = POINTER TO TextLine;
TextLine = RECORD
next: TextLinePtr;
prev: TextLinePtr;
len: INTEGER;
size: INTEGER;
text: ARRAY[0..MaxLen] OF CHAR;
END;
LONG = LONGINT;
String = ARRAY [0..127] OF CHAR;
VAR
Screen: ScreenPtr; (* Screen that contains the Text *)
BM: BitMapPtr; (* Screen's BitMap *)
Window: WindowPtr;
MyFont: TextAttr;
MyFile: FileHandlePtr; (* For loading Textfile *)
FirstLine: TextLinePtr; (* Saved Text *)
TopLine: TextLinePtr; (* Points to topmost Line *)
BottomLine: TextLinePtr; (* Last Line displayed on Screen *)
LoadLine: TextLinePtr; (* currently loaded Line *)
LastLine: TextLinePtr; (* Last element of LineList *)
Name,IStr,FName: String; (* Text's Name *)
Buffer: ARRAY[0..511] OF CHAR; (* Buffer for Reading *)
RQPos: LONG; (* Position within ReadBuffer *)
RQLen: LONG; (* Number of CHARs in Buffer *)
NumLines: INTEGER; (* Number of Lines on Screen *)
NumColumns: INTEGER; (* Number of Columns on Screen *)
AnzLines: LONG; (* Length of Text in Lines *)
Font: TextFontPtr; (* used Font *)
MyLock,New: FileLockPtr;
FileInfo: FileInfoBlockPtr;
FileLength, TextLength: LONG;
CopperList, CopperAlt: UCopListPtr;
Cols: POINTER TO ARRAY[0..3] OF CARDINAL;
Gfxbase: POINTER TO GfxBase;
ScreenPos: INTEGER;
ShowTask: Task;
ShowStack: ARRAY [0..3999] OF CHAR;
ShowTaskRunning: BOOLEAN;
mySig: INTEGER; (* SignalBit *)
SignalNewData,SignalAllRead,Done,print: BOOLEAN;
Me: TaskPtr;
Info: BOOLEAN;
MyMsgPtr: IntuiMessagePtr; (* For receiving Messages *)
i: INTEGER;
Scroll,Fast: BOOLEAN; (* TRUE = Scroll, FALSE = Wait. *)
nili,nilo: FileHandlePtr;
WBSt: WBStartupPtr;
CommLine: POINTER TO CHAR;
InQuotes: BOOLEAN;
ArgPtr: POINTER TO String;
(*-------------------------------------------------------------------------*)
PROCEDURE Alloc(size: LONG): ADDRESS;
VAR a: ADDRESS;
BEGIN
a := AllocMem(size,MemReqSet{memClear});
Assert(a#NIL,ADR(oom));
RETURN a;
END Alloc;
PROCEDURE Length(VAR s: ARRAY OF CHAR): INTEGER;
VAR l: INTEGER;
BEGIN l := 0; WHILE (l<=HIGH(s)) AND (s[l]#0C) DO INC(l) END; RETURN l;
END Length;
PROCEDURE Append(VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
(* appends s2 to s1 *)
VAR p,q: INTEGER;
BEGIN
p := Length(s1); q := 0;
WHILE (p<=HIGH(s1)) AND (q<=HIGH(s2)) AND (p<NumColumns) DO
s1[p] := s2[q]; INC(p); INC(q)
END;
IF p<=HIGH(s1) THEN s1[p] := 0C END;
END Append;
PROCEDURE QText(x{0},y{1}: INTEGER;
str{8}: ADDRESS;
bm{9}: BitMapPtr;
tf{10}: TextFontPtr); (* $E- *)
BEGIN
INLINE(
(*0000*) 048E7H,0F0F0H,03429H,00000H,048C2H,0C2C2H,048C0H,0D280H,
(*0010*) 02269H,00008H,0D3C1H,02202H,0E781H,09282H,05381H,0246AH,
(*0020*) 00022H,01018H,06700H,00082H,01600H,0C63CH,00060H,06600H,
(*0030*) 00034H,012BCH,000FEH,0D3C2H,012BCH,000C6H,0D3C2H,012BCH,
(*0040*) 000C6H,0D3C2H,012BCH,000C6H,0D3C2H,012BCH,000C6H,0D3C2H,
(*0050*) 012BCH,000C6H,0D3C2H,012BCH,000FEH,0D3C2H,012BCH,00000H,
(*0060*) 093C1H,060BEH,0903CH,00020H,06A04H,0903CH,00020H,0C07CH,
(*0070*) 000FFH,047F2H,00000H,01293H,0D3C2H,012ABH,000C0H,0D3C2H,
(*0080*) 012ABH,00180H,0D3C2H,012ABH,00240H,0D3C2H,012ABH,00300H,
(*0090*) 0D3C2H,012ABH,003C0H,0D3C2H,012ABH,00480H,0D3C2H,012ABH,
(*00A0*) 00540H,093C1H,06000H,0FF7CH,04CDFH,00F0FH,04E75H);
END QText;
(*------------------------ Open Display: --------------------------------*)
PROCEDURE InitScreen();
VAR
NuScreen: POINTER TO NewScreen;
NuWindow: POINTER TO NewWindow;
PROCEDURE NuWin; (* $E- *)
BEGIN
INLINE(0,10,0,0,0, (* size, pens *)
8,1032,1,6656, (* idcmp, flags *)
0,0,0,0,0,0, (* gadget, checkmark, title *)
0,0,0,0, (* screen, bitmap *)
0,0,0,0, (* min/max size *)
15); (* customscreen *)
END NuWin;
PROCEDURE NuScrn(); (* $E- *)
BEGIN
INLINE(0,0,0,0,1,0, (* dimensions, pens *)
8000H,271, (* hires,customScreen+ScreenQuiet *)
0,0,0,0,0,0,0,0); (* font, title, gagdets, bitmap *)
END NuScrn;
BEGIN
(*------ Open Screen: ------*)
WITH MyFont DO
name := ADR("topaz.font");
ySize := 8;
style := FontStyleSet{};
flags := FontFlagSet{};
END;
Font := OpenFont(ADR(MyFont));
NuScreen := ADR(NuScrn);
WITH NuScreen^ DO
NumColumns := Gfxbase^.normalDisplayColumns DIV 32 * 4;
IF NumColumns>MaxLen THEN NumColumns := MaxLen END;
width := 8*NumColumns;
NumLines := Gfxbase^.normalDisplayRows DIV 8;
height := 16*NumLines;
END;
Screen := OpenScreen(NuScreen^);
Assert(Screen#NIL,ADR(oom));
BM := Screen^.rastPort.bitMap;
Screen^.height := Screen^.height DIV 2;
MakeScreen(Screen); RethinkDisplay();
(*------ Open Window: ------*)
NuWindow := ADR(NuWin);
WITH NuWindow^ DO
width := NumColumns*8;
height := Screen^.height-10;
screen := Screen;
END;
Window := OpenWindow(NuWindow^);
Assert(Window#NIL,ADR(oom));
END InitScreen;
(*------ Read one TextLine into a Variable: ------*)
PROCEDURE GetTextLine(): TextLinePtr;
(* returns TRUE if EOF *)
VAR
l: TextLinePtr;
sz,le: INTEGER;
c: CHAR;
txt: ARRAY[0..MaxLen] OF CHAR;
PROCEDURE GetCh();
BEGIN
IF RQPos=RQLen THEN
RQLen := Read(MyFile,ADR(Buffer),SIZE(Buffer));
RQPos := 0;
END;
IF RQLen=0 THEN c := 0C ELSE c := Buffer[RQPos]; INC(RQPos); INC(le) END;
END GetCh;
BEGIN
IF RQLen=0 THEN RETURN NIL END;
sz := 0;
le := 0;
LOOP
LOOP
GetCh;
IF (c#33C) AND (c#233C) THEN EXIT END;
REPEAT GetCh; c:= CAP(c) UNTIL (c>="?") AND (c<="Z") OR (c=0C);
END;
CASE c OF
11C:
REPEAT
txt[sz] := " "; INC(sz);
UNTIL (sz=NumColumns) OR (sz MOD 8 = 0);
DEC(sz); |
10C: DEC(sz,2); IF sz<-1 THEN sz := -1 END |
12C,0C: EXIT |
240C,14C: txt[sz] := " " |
ELSE txt[sz] := c END;
INC(sz);
IF sz>=NumColumns THEN EXIT END;
END;
l := Alloc(SIZE(TextLine)-MaxLen+sz);
WITH l^ DO
len := le; size:= sz;
WHILE sz>0 DO DEC(sz); text[sz]:=txt[sz] END;
END;
RETURN l;
END GetTextLine;
(*------ Clear one Line: ------*)
PROCEDURE Clear(BM{8}: BitMapPtr; Line{0}: INTEGER);
BEGIN
INLINE(
0C1D0H, (* MULS bm_BytesPerRow(BM),Line *)
02268H,00008H, (* MOVE.L bm_Planes(BM),A1 *)
0D3C0H, (* ADD.L Line,A1 *)
03210H, (* MOVE bm_BytesPerRow(BM),D1 *)
05341H, (* SUBQ #1,D1 *)
04299H, (* L: CLR.L (A1)+ *)
04299H, (* CLR.L (A1)+ *)
051C9H,0FFFAH); (* DBRA D1,L *)
END Clear;
(*------ Type one Line of Text: ------*)
PROCEDURE TypeLine(str: ADDRESS; PosY: INTEGER);
BEGIN
Clear(BM,PosY*8); QText(0,8*PosY,str,BM,Font);
END TypeLine;
(*------ Write Line at Bottom of Text: ------*)
PROCEDURE AddBottomLine(Line: TextLinePtr; Fast: BOOLEAN);
VAR
i,j: INTEGER;
trash: LONG;
source,dest: POINTER TO LONG;
BEGIN
WITH Screen^.viewPort.rasInfo^ DO
TypeLine(ADR(Line^.text),ScreenPos+NumLines);
dest := BM^.planes[0];
INC(dest,8*LONG(ScreenPos)*LONG(NumColumns));
source := dest;
INC(source,8*LONG(NumLines)*LONG(NumColumns));
IF Fast THEN
INC(ryOffset,8);
MakeScreen(Screen); RethinkDisplay();
FOR j:=1 TO NumColumns*2 DO dest^ := source^; INC(dest,4); INC(source,4) END;
ELSE
FOR i:=0 TO 7 DO
INC(ryOffset);
MakeScreen(Screen); RethinkDisplay();
FOR j:=1 TO NumColumns DIV 4 DO dest^ := source^; INC(dest,4); INC(source,4) END;
END;
END;
INC(ScreenPos);
IF ScreenPos=NumLines THEN
ScreenPos := 0;
ryOffset := 0;
END;
END;
END AddBottomLine;
(*------ Write String to Screen: ------*)
PROCEDURE Write(String: ARRAY OF CHAR; Fast: BOOLEAN);
VAR text: TextLine;
BEGIN
text := FirstLine^;
i := Length(String);
IF i>=NumColumns THEN i := NumColumns-1 END;
text.text[i+1] := 0C;
REPEAT text.text[i] := String[i]; DEC(i) UNTIL i<0;
AddBottomLine(ADR(text),Fast);
END Write;
(*------ Scroll down one Line: ------*)
PROCEDURE ScrollDown(Fast: BOOLEAN);
(* Returns TRUE if EOF *)
BEGIN
IF (BottomLine^.next=NIL) AND (MyFile#NIL) THEN
SignalNewData := w;
REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
SignalNewData := f;
END;
IF BottomLine^.next#NIL THEN
BottomLine := BottomLine^.next;
INC(AnzLines);
INC(TextLength,BottomLine^.len);
ELSE RETURN END;
IF AnzLines>=NumLines THEN
TopLine := TopLine^.next;
END;
AddBottomLine(BottomLine,Fast);
END ScrollDown;
(*------ Scroll Up one Line: ------*)
PROCEDURE ScrollUp(Fast: BOOLEAN);
VAR
i,j: INTEGER;
source,dest: POINTER TO LONG;
BEGIN
IF TopLine^.prev#NIL THEN
TopLine := TopLine^.prev;
DEC(TextLength,BottomLine^.len);
DEC(AnzLines);
BottomLine := BottomLine^.prev;
WITH Screen^.viewPort.rasInfo^ DO
IF ScreenPos=0 THEN
ryOffset := NumLines*8;
ScreenPos := NumLines-1;
ELSE
DEC(ScreenPos);
END;
TypeLine(ADR(TopLine^.prev^.text),ScreenPos);
source := BM^.planes[0];
INC(source,(LONG(ScreenPos)+1)*8*LONG(NumColumns)-4);
dest := source;
INC(dest,LONG(NumLines)*LONG(NumColumns)*8);
IF Fast THEN
DEC(ryOffset,8);
MakeScreen(Screen); RethinkDisplay();
FOR j:=1 TO NumColumns*2 DO dest^ := source^; DEC(dest,4); DEC(source,4) END;
ELSE
FOR i:=0 TO 7 DO
DEC(ryOffset);
MakeScreen(Screen); RethinkDisplay();
FOR j:=1 TO NumColumns DIV 4 DO dest^ := source^; DEC(dest,4); DEC(source,4) END;
END;
END;
END;
END; (* IF TopLine#NIL ... *)
END ScrollUp;
(*------ Undo last Write(): ------*)
PROCEDURE DelLine();
VAR
i,j: INTEGER;
source,dest: POINTER TO LONG;
text: TextLine;
BEGIN
WITH Screen^.viewPort.rasInfo^ DO
IF ScreenPos=0 THEN
ryOffset := NumLines*8;
ScreenPos := NumLines-1;
ELSE
DEC(ScreenPos);
END;
IF TopLine^.prev#NIL THEN
TypeLine(ADR(TopLine^.prev^.text),ScreenPos)
ELSE
TypeLine(ADR(FirstLine^.text),ScreenPos);
END;
source := BM^.planes[0];
INC(source,(LONG(ScreenPos)+1)*8*LONG(NumColumns)-4);
dest := source;
INC(dest,LONG(NumLines)*LONG(NumColumns)*8);
FOR i:=0 TO 7 DO
DEC(ryOffset);
MakeScreen(Screen); RethinkDisplay();
FOR j:=1 TO NumColumns DIV 4 DO dest^ := source^; DEC(dest,4); DEC(source,4) END;
END;
END;
END DelLine;
(*------ Clear Display: ------*)
PROCEDURE ClearBitMaps();
BEGIN
WITH BM^ DO
BltClear(planes[0],bytesPerRow*rows,0);
ScreenPos := 0;
Screen^.viewPort.rasInfo^.ryOffset := 0;
END;
END ClearBitMaps;
(*------ Convert Integer to String: ------*)
PROCEDURE IntToStr(VAR String: ARRAY OF CHAR;
At,Chars: INTEGER;
int: LONG);
VAR
Cnt: INTEGER;
Ziff: LONG;
BEGIN
IF (Length(String)<Chars+At) AND (HIGH(String)>=Chars+At) THEN
String[Chars+At] := 0C;
END;
Cnt := Chars; Ziff := 1;
WHILE Cnt>1 DO
Ziff := Ziff * 10;
DEC(Cnt);
END;
Cnt := 0;
WHILE Cnt<Chars DO
String[Cnt+At] := "0";
WHILE int>=Ziff DO
DEC(int,Ziff);
INC(String[Cnt+At]);
END;
Ziff := Ziff DIV 10;
INC(Cnt);
END;
Cnt := 0;
WHILE (Cnt<Chars-1) AND (String[Cnt+At]="0") DO
String[Cnt+At] := " ";
INC(Cnt)
END;
END IntToStr;
(*-------------------------------------------------------------------------*)
PROCEDURE GetLength(t: TextLinePtr);
BEGIN
TextLength := 0; AnzLines := 0;
WHILE t#NIL DO INC(AnzLines); INC(TextLength,t^.len); t := t^.prev END;
END GetLength;
(*-------------------------------------------------------------------------*)
PROCEDURE NewDisplay();
(* Zeichnet ab BottomLine neu *)
VAR
i: INTEGER;
l: TextLinePtr;
BEGIN
ClearBitMaps;
i := 1;
l := BottomLine;
WHILE (i<NumLines) AND (BottomLine^.next#NIL) DO
BottomLine := BottomLine^.next;
INC(i);
END;
WHILE (i<NumLines) AND (l^.prev#NIL) DO l := l^.prev; INC(i) END;
BottomLine := l;
GetLength(l);
Write(empty,w);
AddBottomLine(BottomLine,w);
FOR i:=0 TO NumLines-2 DO
TopLine := l;
ScrollDown(w);
END;
Scroll := f;
END NewDisplay;
(*-------------------------------------------------------------------------*)
PROCEDURE ShowProc();
VAR
l: TextLinePtr;
Down: BOOLEAN; (* Scroll-Direction *)
End: BOOLEAN; (* Quit next time Space is pressed ? *)
i,j,k,m: INTEGER;
MyMsg: IntuiMessage; (* contains Message *)
Shift: BOOLEAN; (* Shifted Keystroke ? *)
Alt: BOOLEAN; (* Altered Keystroke ? *)
NuWindow: POINTER TO NewWindow;
win: WindowPtr;
StrGadget: GadgetPtr;
StrInfo: POINTER TO StringInfo;
Find: ARRAY[0..79] OF CHAR;
flen: INTEGER;
PROCEDURE NuWin; (* $E- *)
BEGIN
INLINE(100,0,0,12,1, (* size, pens *)
8,64,0,4096, (* idcmp, flags *)
0,0,0,0,0,0, (* gadget, checkmark, title *)
0,0,0,0, (* screen, bitmap *)
0,0,0,0, (* min/max size *)
15); (* customscreen *)
END NuWin;
PROCEDURE StrGdg(); (* $E- *)
BEGIN
INLINE(0,0, (* next *)
2,2,0,8, (* size *)
0,513, (* flags, activation *)
strGadget,
0,0,0,0,0,0, (* render, selectr., text *)
0,0,0,0,0); (* mutualexcl, specialinfo *)
END StrGdg;
PROCEDURE StrInf(); (* $E- *)
BEGIN
INLINE(0,0,0,0,0, (* buffer, undobuffer, bufferpos *)
80,0,0,0, (* maxchars, disppos, undopos, numchars *)
0,0,0,0,0,
0,0,0,0);
END StrInf;
BEGIN
Scroll := w; Fast := f; Down := w; End := f; Find := empty;
LOOP
(*------ Type Text: ------*)
IF Scroll THEN
IF Down THEN
ScrollDown(Fast);
Scroll := (MyFile#NIL) OR (BottomLine^.next#NIL);
ELSE
ScrollUp(Fast);
Scroll := TopLine^.prev#NIL;
END;
ELSE
WaitPort(Window^.userPort);
END;
MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
WHILE (MyMsgPtr#NIL) AND (inactiveWindow IN MyMsgPtr^.class) DO
WaitPort(Window^.userPort);
MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
END;
IF MyMsgPtr#NIL THEN
MyMsg := MyMsgPtr^;
ReplyMsg(MessagePtr(MyMsgPtr));
WITH MyMsg DO
IF class=IDCMPFlagSet{mouseButtons} THEN
class := IDCMPFlagSet{rawKey};
IF leftButton IN QualifierSet(qualifier) THEN
code := 40H;
ELSIF rightButton IN QualifierSet(qualifier) THEN
code := 41H;
END;
END;
IF (class=IDCMPFlagSet{rawKey}) AND (code<80H) THEN
IF Info THEN
Screen^.viewPort.uCopIns := CopperAlt;
DelLine();
Info := f;
END;
Shift := (lShift IN QualifierSet(qualifier)) OR
(rShift IN QualifierSet(qualifier)) OR
(capsLock IN QualifierSet(qualifier));
Alt := (lAlt IN QualifierSet(qualifier)) OR
(rAlt IN QualifierSet(qualifier));
CASE code OF
40H: (* Space *)
Fast := Shift;
IF (MyFile=NIL) AND (BottomLine^.next=NIL) THEN
IF End THEN EXIT ELSE End:=w END;
ELSE
End := f;
END;
IF Down THEN
IF Scroll OR End THEN
(* File: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines *)
IStr := "File: ";
Append(IStr,Name);
Append(IStr," ");
IStr[36] := 0C;
Append(IStr,"xxx % (xxxxxx of xxxxxx Bytes) xxxxxx Lines");
IntToStr(IStr,36,3,TextLength * 100 DIV FileLength);
IntToStr(IStr,43,6,TextLength);
IntToStr(IStr,53,6,FileLength);
IntToStr(IStr,67,6,AnzLines-1);
Write(IStr,f);
CopperAlt := Screen^.viewPort.uCopIns;
Screen^.viewPort.uCopIns := CopperList;
RethinkDisplay();
Info := w;
END;
Scroll := NOT(Scroll);
ELSE
Down := w;
Scroll := w;
END; |
41H: (* BackSpace *)
Fast := Shift;
Scroll := Down OR NOT(Scroll);
Down := f |
4DH,1EH,1FH: (* Down *)
IF Shift THEN
Scroll := NOT(Down AND Scroll) OR NOT(Fast);
Fast := w; Down := w;
ELSE
i:=1; IF Alt OR (code=1FH) THEN i:=NumLines END;
WHILE i#0 DO
ScrollDown(NOT(Shift));
DEC(i);
END;
Scroll := f;
END |
4CH,3EH,3FH: (* Up *)
IF Shift THEN
Scroll := Down OR NOT(Scroll) OR NOT(Fast);
Fast := w; Down := f;
ELSE
i:=1; IF Alt OR (code=3FH) THEN i:=NumLines END;
WHILE i#0 DO
ScrollUp(NOT(Shift));
Scroll := f;
DEC(i);
END;
END; |
44H,43H: (* CR *)
ScrollDown(f);
Scroll := f; |
14H,3DH: (* Home *)
i:=NumLines-AnzLines;
IF i>0 THEN
WHILE i>0 DO DEC(i); ScrollDown(w) END; Scroll := f;
ELSE
BottomLine := FirstLine; NewDisplay();
END |
35H,1DH: (* End *)
IF MyFile#NIL THEN
SignalAllRead := w;
REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
SignalAllRead := f;
END;
BottomLine := LastLine;
i:=NumLines;
WHILE (i>1) AND (BottomLine^.prev#NIL) DO
BottomLine := BottomLine^.prev;
DEC(i);
END;
NewDisplay() |
23H,36H: (* Find *)
IF code=23H THEN
Screen^.height := 2*Screen^.height;
MakeScreen(Screen); RethinkDisplay();
NuWindow := ADR(NuWin);
StrGadget := ADR(StrGdg);
StrInfo := ADR(StrInf);
WITH NuWindow^ DO
topEdge := NumLines*4-6+Screen^.viewPort.rasInfo^.ryOffset;
width := NumColumns*8-200;
firstGadget:= StrGadget;
screen := Screen;
StrGadget^.width := width-4;
StrGadget^.specialInfo := StrInfo;
END;
StrInfo^.buffer := ADR(Find);
win := OpenWindow(NuWindow^);
IF win=NIL THEN EXIT END;
IF ActivateGadget(StrGadget,win,NIL) THEN END;
WaitPort(win^.userPort);
CloseWindow(win);
Screen^.height := Screen^.height DIV 2;
END;
ClearBitMaps();
IF Find[0]#0C THEN
IF MyFile#NIL THEN
SignalAllRead := w;
REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
SignalAllRead := f;
END;
BottomLine := TopLine;
flen := Length(Find);
LOOP
WITH BottomLine^ DO
i := 0;
IF len<NumColumns THEN m := len ELSE m := NumColumns END;
m := m-flen;
WHILE i<m DO
j := 0; k := i;
WHILE CAP(text[k])=CAP(Find[j]) DO
INC(j); INC(k);
IF Find[j]=0C THEN EXIT END;
END;
INC(i);
END;
END;
IF BottomLine^.next=NIL THEN EXIT END;
BottomLine := BottomLine^.next;
END;
ELSE
BottomLine := TopLine;
END;
NewDisplay |
19H: (* find previous *)
IF Find[0]#0C THEN
ClearBitMaps();
BottomLine := TopLine;
IF BottomLine^.prev#NIL THEN BottomLine:=BottomLine^.prev END;
flen := Length(Find);
LOOP
IF BottomLine^.prev=NIL THEN EXIT END;
BottomLine := BottomLine^.prev;
WITH BottomLine^ DO
i := 0;
IF len<NumColumns THEN m := len ELSE m := NumColumns END;
m := m-flen;
WHILE i<m DO
j := 0; k := i;
WHILE CAP(text[k])=CAP(Find[j]) DO
INC(j); INC(k);
IF Find[j]=0C THEN EXIT END;
END;
INC(i);
END;
END;
END;
NewDisplay();
END |
18H: IF Shift AND Alt THEN (* Printout *)
IStr := "RUN >NIL: TYPE >NIL: "; Append(IStr,FName);
Append(IStr," TO PRT:"); print := TRUE; Signal(Me,LONGSET{mySig});
REPEAT UNTIL mySig IN Wait(LONGSET{mySig});
print := FALSE;
END |
5FH,25H: ClearBitMaps(); Write(empty,w);
Write(title,w);
Write(underln,w);
Write(empty,w);
Write("Commands:",w);
Write(empty,w);
Write(" Space, LMB: Start / Stop scrolling. Quit at end of file.",w);
Write(" BackSpace, RMB: Start / Stop scrolling backwards.",w);
Write(" Up/Down: Move one line up or down.",w);
Write(" Shift + Up/Down: Start / Stop quick scrolling up or down.",w);
Write(" Alt + Up/Dwn: Move one page up or down.",w);
Write(" PgUp/PgDn: Move one page up or down.",w);
Write(" T, Home: Jump to first page.",w);
Write(" B, End: Jump to last page.",w);
Write(" F: Find string.",w);
Write(" N: Jump to next occurance of string.",w);
Write(" P: Jump to previous occurance of string.",w);
Write(" Shift + Alt + O: Create printout of the text",w);
Write(" HELP, H: Show Commands.",w);
Write(" ESC, Q, X, NK 5: Quit.",w);
Write(empty,w);
Write(address,w);
Write(empty,w);
LOOP
WaitPort(Window^.userPort);
MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
IF (rawKey IN MyMsgPtr^.class) AND (MyMsgPtr^.code<128) THEN EXIT END;
ReplyMsg(MyMsgPtr);
END;
ReplyMsg(MyMsgPtr);
BottomLine := TopLine;
NewDisplay |
10H,45H,32H,2EH: EXIT | (* ESC, Q, X, NK 5 *)
ELSE END; (* CASE code OF *)
END; (* IF class=IDCMPFlagSet{rawKey} THEN *)
END; (* WITH MyMsg DO *)
END; (* IF MyMsgPtr#NIL THEN *)
END; (* LOOP *)
Done := w;
Signal(Me,LONGSET{mySig});
WHILE w OR (1 IN Wait(LONGSET{})) DO END;
END ShowProc;
(*------ Print: ------*)
PROCEDURE Print;
BEGIN
IF print THEN
nili := Open(ADR(nil),oldFile);
nilo := Open(ADR(nil),newFile);
SETREG(0,Execute(ADR(IStr ),nili,nilo));
Delay(20); Close(nili); Close(nilo);
Signal(ADR(ShowTask),LONGSET{mySig});
END
END Print;
(*------ Usage: ------*)
PROCEDURE Usage;
BEGIN
Write(title,f); Write(underln,f); Write(empty,f);
Write("A soft-scrolling ASCII-File-Printer.",f); Write(empty,f);
Write("Usage: ",f); Write(empty,f);
Write(" MuchMore <FileName>",f); Write(empty,f);
Write("To start from Workbench click text to print before",f); Write(empty,f);
Write("shift-doubleclicking MuchMore. ",f); Write(empty,f);
Write("Texts with MuchMore as their default-tool just have to be doubleclicked",f); Write(empty,f);
Write("This can be run on NTSC as well as on PAL Amigas.",f); Write(empty,f);
Write(address,f);
Write("This is free to be spread on PD or Shareware Disks, as long as",f);
Write("you leave my name and address in.",f);
Write("It's illegal to make comercial use of this without my written permission!",f);
Write(empty,f);
WaitPort(Window^.userPort);
Terminate(0);
END Usage;
(*------ CleanUp: ------*)
PROCEDURE CleanUp();
VAR t: TextLinePtr;
BEGIN
IF ShowTaskRunning THEN RemTask(ADR(ShowTask)) END;
IF Window#NIL THEN CloseWindow(Window) END;
IF Screen#NIL THEN
IF Info THEN Screen^.viewPort.uCopIns := CopperAlt END;
CloseScreen(Screen)
END;
IF MyFile#NIL THEN Close(MyFile) END;
WHILE FirstLine#NIL DO
t := FirstLine;
FirstLine := FirstLine^.next;
FreeMem(t,SIZE(TextLine)-MaxLen+t^.size);
END;
IF MyLock#NIL THEN UnLock(MyLock) END;
IF New #NIL THEN UnLock(New ) END;
IF FileInfo#NIL THEN FreeMem(FileInfo,SIZE(FileInfo^)) END;
IF CopperList#NIL THEN
IF CopperList^.firstCopList#NIL THEN
FreeCopList(CopperList^.firstCopList);
END;
FreeMem(CopperList,SIZE(CopperList^));
END;
IF Font#NIL THEN CloseFont(Font) END;
IF mySig#-1 THEN FreeSignal(mySig) END;
END CleanUp;
(*------------------------------ MAIN: ----------------------------------*)
BEGIN
(*------ Init: ------*)
Screen := NIL; Window := NIL; FirstLine := NIL; TopLine := NIL;
BottomLine := NIL; MyFile := NIL; AnzLines := 0; Font := NIL; Info := f;
MyLock := NIL; FileInfo := NIL; TextLength := 0; ScreenPos := 0;
CopperList := NIL; ShowTaskRunning := f; SignalNewData := f;
SignalAllRead := f; Done := f; print := f; mySig := -1; Me := FindTask(0);
Gfxbase := ADR(Graphics); New := NIL;
TermProcedure(CleanUp);
(*------ Setup: ------*)
InitScreen();
Cols := Screen^.viewPort.colorMap^.colorTable;
FirstLine := Alloc(SIZE(TextLine)-MaxLen);
FirstLine^.size := 0;
FirstLine^.text[0] := 0C;
LastLine := FirstLine;
BottomLine := FirstLine;
TopLine := FirstLine;
AnzLines := 1;
FileInfo := Alloc(SIZE(FileInfo^));
CopperList := Alloc(SIZE(CopperList^));
CWait(CopperList, Screen^.height-8, 0); CBump(CopperList);
CMove(CopperList, ADR(custom.color[0]),Cols^[2]); CBump(CopperList);
CWait(CopperList, Screen^.height, 0); CBump(CopperList);
CMove(CopperList, ADR(custom.color[0]),Cols^[0]); CBump(CopperList);
CWait(CopperList, 10000,255);
(*------ Start: ------*)
WBSt:= startupMsg;
IF wbStarted THEN
WITH WBSt^ DO
IF numArgs=2 THEN
ArgPtr := argList^[1].name; Name := ArgPtr^;
SETREG(0,CurrentDir(argList^[1].lock));
ELSE Usage END
END;
ELSE
CommLine:=dosCmdBuf; InQuotes:=FALSE; i:=0;
WHILE CommLine^=" " DO INC(CommLine) END;
WHILE (CommLine^>" ") OR InQuotes AND (CommLine^=" ") DO
IF CommLine^='"' THEN InQuotes := NOT InQuotes ELSE
Name[i] := CommLine^; IF i<127 THEN INC(i) END END;
INC(CommLine);
END;
IF i=0 THEN Usage END;
Name[i]:= 0C;
END;
MyFile := Open(ADR(Name),oldFile);
Assert(MyFile#NIL,ADR(cof));
RQPos := -1; RQLen := -1;
MyLock := Lock(ADR(Name),sharedLock);
Assert(MyLock#NIL,ADR(cof));
Assert(Examine(MyLock,FileInfo)#0,ADR(cof));
FileLength := FileInfo^.size;
i := 1; FName := empty;
WHILE MyLock#NIL DO
IF (Examine(MyLock,FileInfo)#0) THEN
IStr := empty; Append(IStr,FileInfo^.fileName);
IF i=0 THEN Append(IStr,"/") ELSE i:=0 END;
Append(IStr,FName); FName := IStr;
END;
New:=ParentDir(MyLock); UnLock(MyLock); MyLock := New; New := NIL;
END; i:=0;
LOOP CASE FName[i] OF "/": FName[i] := ":"; EXIT | 0C: EXIT ELSE END; INC(i) END;
MyLock := NIL;
mySig := AllocSignal(-1);
IF mySig<0 THEN Terminate(0) END;
WITH ShowTask DO
spLower := ADR(ShowStack);
spUpper := ADR(ShowStack[3996]);
spReg := spUpper;
node.type := task;
node.name := ADR("Show.MM");
node.pri := 1;
END;
Forbid();
LOOP
MyMsgPtr := ADDRESS(GetMsg(Window^.userPort));
IF MyMsgPtr=NIL THEN EXIT END;
ReplyMsg(MyMsgPtr);
END;
Window^.userPort^.sigTask := ADR(ShowTask);
AddTask(ADR(ShowTask),ADR(ShowProc),NIL);
ShowTaskRunning := w;
Permit();
i := 0;
REPEAT
INC(i);
IF i=20 THEN
Assert(AvailMem(MemReqSet{chip,largest})>10000,ADR(oom));
i := 0;
END;
LoadLine := GetTextLine();
IF LoadLine=NIL THEN
Close(MyFile);
MyFile := NIL;
ELSE
LoadLine^.prev := LastLine;
Forbid();
LastLine^.next := LoadLine;
LastLine := LoadLine;
Permit;
END;
IF SignalNewData THEN Signal(ADR(ShowTask),LONGSET{mySig}) END;
Print;
UNTIL (MyFile=NIL) OR Done;
IF SignalAllRead THEN Signal(ADR(ShowTask),LONGSET{mySig}) END;
REPEAT REPEAT UNTIL mySig IN Wait(LONGSET{mySig}); Print UNTIL Done;
END MuchMore.